home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1996 March
/
EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso
/
earcd
/
util1
/
repack34.lha
/
Repack.rexx.BBS
< prev
next >
Wrap
File List
|
1995-12-14
|
16KB
|
652 lines
/* Welcome, dumper!
LHA-LZX V1.0-2.0 by Mat Bettinson of the Plot Hatching Factory '95
LHA-LZX V3.0 and above by Andrea Vallinotto.
$VER: LZX Repacker V 3.4_C-net, by Andrea Vallinotto (14.12.95)
© 1995 Nathan Johnes Software lavatories :->
************ SPECIAL BBS VERSION FOR C-Net and other BBS systems **************
Since Jonathan Forbes' brilliant LZX came along and promptly blew LHA away,
there's a need for a bulk converter. This is such a device.
You can execute this script with the following parameters: destination
directory (any valid path name), temp directory (as above), efficiency
(either 1, 2 or 3), BBS mode ('on' or any other string for 'off').
If you wish, you can change the value of the LZX merging-group in the
beginning of the program (see below!).
C-Net suggested string:
'rx repack.rexx <source-file-name> <temp-dir> 3 ON'
On C-Net repack is useful if used in the 'transform' operation that occours just
after the upload of a file (after the test). Keep in mind that no matter which
format the file is, after the repacking you'll have a LZX archive.
BEWARE: the temp dir must be large enough to accommodate the largest extracted
archive you're converting (including sub-archives, if present!).
You'll need:
in your search path: for lha and lzh archives either Lha, Lhx or LZX registered;
for tar archives either Tar, Gnutar or Detar,
and unzip, unarj, unrar, hpack, shrink, xarc, zoo, arc,
gzip, LZX, Delete, Assign, Setdate, Filenote and Which.
Since this version, LZX version 1.21 or above is REQUIRED!
You can change the following value to suit you needs! It's the maximum group
size that LZX can create. */
groupsize=2900
/* Don't modify nothing below this line: spaghetti code lies behind...
DON'T SAY YOU'VE NOT BEEN WARNED!!
(But what kind of code would you expect from an Italian, anyway ? :-)) ) */
options results
options failat 9
signal on break_c
signal on halt
verstring='LZX Repacker version 3.4_C-Net'
parse var verstring jf utilname blah ver .
titlestring=left(utilname,6) ver
copyleft='by Andrea Vallinotto of Nowhere software'
lstring="#?.(LZH|LHA|ZIP|ARJ|RAR|SHR|XAR|HPK|ARC|ZOO|PAK|TAR|GZ|Z|TGZ)"
logname='t:Repack.log'
anofile='s:repack.ano'
cr='0a'x
bold='1b'x'[1m'
normal='1b'x'[0m'
under='1b'x'[4m'
setuplib("rexxsupport.library",0,-30,0)
parse source . . . scriptname . .
if ~exists(scriptname) then signal badinstall
call checklzx
parse arg instring
hmq=length(instring)-length(compress(instring,'"'))
select
when hmq // 2 then signal baddata
when hmq=0 then do
parse var instring Dir root mode bbsmode quiet .
signal init
end
otherwise nop
end
a=0
loop:
instring=strip(instring,L)
a=a+1
select
when left(instring,1)='"' then do
parse var instring '"' foo.a '"' instring
signal loop
end
when left(instring,1)="" then do
foo.0=a-1
signal complete
end
otherwise do
parse var instring foo.a instring
signal loop
end
end
complete:
if foo.0>0 then dir= foo.1
else dir=''
if foo.0>1 then root= foo.2
else root=''
if foo.0>2 then mode= foo.3
else mode=''
if foo.0>3 then bbsmode= foo.4
else bbsmode=''
if foo.0>4 then quiet= foo.5
else quiet=''
init:
bbsmode=upper(bbsmode)
if lzxreg then maxeff=9
else maxeff=3
if (mode > maxeff | mode < 0) then signal baddata
if quiet ='' then do
say;say ' *** LHA-LZX repacker 1.0-2.0 by Mat Bettinson of the Plot Hatching Factory ***'
say ' *** 'verstring copyleft '***';say
end
oldstack=Pragma('S',50000)
If right(root,1) ~= '/' & right(root,1) ~= ':' then root = root'/'
/* this procedure must be left even in SFM because it could be called while
recursing on a single file (on dir/RTD) */
bestia=whatis(dir)
select
when bestia='' then signal baddata
when bestia='FILE' then sfm(dir)
otherwise sfm=0
end
call initlog('on directory' dir)
If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
if ~(length(root)-length(compress(root,':'))) then root=pragma(d)'/'root
tempdir=root'RTD'
mkdir(tempdir)
if ~(length(dir)-length(compress(dir,':'))) then
if right(pragma(d),1)=':' then dir=pragma(d)dir
else dir=pragma(d)'/'dir
else
if dir=':' then dir=pragma(d)
if bbsmode='ON' then do
Address COMMAND 'List 'quote(dir)' P 'lstring' DATES TO 'quote(root'lha-lzx_infos.temp')' FILES LFORMAT "%d %t %c"'
Call Open(infos,root'lha-lzx_infos.temp','R')
end
if exists(quiet'recursive_LZX_repack.temp') then Call Open(list,quiet'recursive_LZX_repack.temp','R')
else do
Address COMMAND "List "quote(Dir)" P "lstring" TO "quote(root'LHA-LZX.temp')" FILES LFORMAT %n"
Call Open(list,root'LHA-LZX.temp','R')
end
Call Pragma('D',tempdir)
call Writelogoptions
/* Mainloop */
BSave = 0
mainloop:
call initano
DO forever
File = ReadLN(list)
IF EOF(list) then break
if bbsmode='ON' then do
mix = ReadLN(infos)
Datetime = subword(mix,1,2)
Comment = quote(subword(mix,3))
end
NewFile = Left(File,lastpos('.',file))'LZX'
say 'Converting file: 'File
Midcleanup()
Lhasize=Size(Dir||File)
signal on failure
WriteLog('Trying to extract' file)
arctype=extract(Dir||File)
signal off failure
if arctype="???" then do
Say "Cannot determine arc type... skipping!"
WriteLog("Couldn't determine arc type of" File '...skipped!')
iterate
end
WriteLog('File' file 'extracted OK. Repacking...')
Address COMMAND 'List PAT 'lstring' FILES ALL LFORMAT %p%n >'quote(root'recursive_LZX_repack.temp')
if size(root'recursive_LZX_repack.temp') ~= 0 then do
WriteLog('Started recursion for file' file)
Close(log)
Address REXX scriptname quote(tempdir) quote(tempdir) mode bbsmode quote(root)
Call Open(log,logname,'A')
end
Call fano
old=pragma(d,tempdir)
signal on failure
if lzxreg then lzxmode=mode' -Qf'
else lzxmode=mode
Address COMMAND 'LZX -r -e -a -M'groupsize' -'lzxmode' -F a 'quote(Dir||NewFile) '#?'
signal off failure
call pragma(d,old)
Lzxsize=Size(Dir||Newfile)
Diff = Lhasize - Lzxsize
Address COMMAND 'Delete >NIL: 'quote(Dir||File) 'FORCE'
if bbsmode='ON' then do
Address COMMAND 'Setdate >NIL: 'quote(Dir||NewFile) Datetime
Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) Comment
end
else Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) quote('Repacked by' utilname ver 'from' arctype 'archive; gained:' diff 'bytes!')
say '* 'Diff' bytes saved on this 'arctype' archive!' ; say
WriteLog('Converted' file 'to' newfile ', gained' Diff 'bytes')
BSave = BSave + Diff
END
if bsave=0 then Bsave="Sorry, no"
select
when quiet='ON' then WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
when quiet~='' then WriteLog('Finished file recursion')
otherwise nop
end
Cleanup:
Call PRAGMA('D',root)
Call Close(list)
Call Close(log)
if bbsmode='ON' then Call Close(infos)
Address COMMAND 'Delete >NIL: 'quote(tempdir)' ALL FORCE'
call Delete(root'LHA-LZX.temp')
call Delete(root'lha-lzx_infos.temp')
call Delete(root'recursive_LZX_repack.temp')
call pragma('s',oldstack)
EXIT 0
sfm:
/* Single file mode... */
parse arg sngfile
sfm=1
/* deve dare fn e dir */
fn=substr(sngfile,max(lastpos(':', sngfile),lastpos('/', sngfile)) +1)
dir=left(arg(1),max(lastpos(':',sngfile),lastpos('/',sngfile)))
if ~(length(dir)-length(compress(dir,':'))) then /* Nel dir non ci sono i : */
if right(pragma(d),1)=':' then dir=pragma(d)dir /* Se siamo in root, dir=root||dir */
else dir=pragma(d)'/'dir /* Se non siamo in root, dir=cwd||/||dir */
else
if dir=':' then dir=pragma(d) /* Ci sono i : ma solo quelli! (siamo in root)*/
call initlog('on file' dir||fn)
call writelogoptions
open(fake,root'lha-lzx.temp',W)
writeln(fake,fn)
close(fake)
tempdir=root'RTD'
Mkdir(tempdir)
if bbsmode='ON' then do
Address COMMAND 'List 'quote(Dir||fn)' DATES FILES LFORMAT "%d %t %c" >'quote(root'lha-lzx_infos.temp')
Call Open(infos,root'lha-lzx_infos.temp','R')
end
Call Pragma('D',tempdir)
Call Open(list,root'LHA-LZX.temp','R')
Bsave=0
signal mainloop
midcleanup:
Address COMMAND 'Delete >NIL: "'tempdir'/#?" ALL FORCE'
return 1
badinstall:
Say "Repack has been incorrectly installed! See the DOCS!"
signal badexit
baddata:
Say 'One or more of the parameters supplied on the command line is bogus!!!'
badexit:
Say '"Computer, end program!"'
exit 5
extract:
parse arg fullname
select
when checklha(fullname) then arc=extlha(quote(fullname))
when checkzip(fullname) then arc=extzip(quote(fullname))
when checkarj(fullname) then arc=extarj(quote(fullname))
when checkrar(fullname) then arc=extrar(quote(fullname))
when checkshr(fullname) then arc=extshr(quote(fullname))
when checkxar(fullname) then arc=extxar(quote(fullname))
when checkarc(fullname) then arc=extarc(quote(fullname))
when checkzoo(fullname) then arc=extzoo(quote(fullname))
when checkpak(fullname) then arc=extpak(quote(fullname))
when checktgz(fullname) then arc=exttgz(quote(fullname))
when checktar(fullname) then arc=exttar(quote(fullname))
when checkgzip(fullname) then arc=extgzip(quote(fullname))
when checkhpack(fullname) then arc=exthpack(quote(fullname))
otherwise arc="???"
end
return arc
extlha:
lxc='lha -a -F -M x'
if (lzxreg & lha_h_l(arg(1))~='02'x) then lxc='lzx -a -F x'
else if pathexists('lhx') then lxc='lhx -a -F -M x'
Address COMMAND lxc arg(1) '#?'
return "LHA"
extzip:
rctest=2
options failat rctest
Address COMMAND 'unzip -a -q 'arg(1)
options failat 9
return "ZIP"
extarj:
rctest=20
options failat rctest
Address COMMAND 'unarj x 'arg(1)
options failat 9
return "ARJ"
extrar:
Address COMMAND 'unrar x 'arg(1)
return "RAR"
extshr:
Address COMMAND 'shrink x 'arg(1) /* Unable to test if extr. failed! */
return "Shrink"
extxar:
address command 'xarc -x 'arg(1) /* Unable to test if extr. failed! */
return "XARC"
exthpack:
Address COMMAND 'hpack x -DA -R 'arg(1) /* Unable to test if extr. failed! */
return "Hpack"
extarc:
Address COMMAND 'arc e 'arg(1)
return "ARC"
extzoo:
rctest=1
options failat rctest
Address COMMAND 'zoo eq/ 'arg(1)
options failat 9
return "ZOO"
exttgz:
extgzip(arg(1))
exttar(exitname)
call delete(exitname)
return "Tar-Gzipped"
extgzip:
sss = Left(file,(lastpos('.',file)-1))
exitname=tempdir'/'||(right(sss,(length(sss)-lastpos('/',sss))))
rctest=1
options failat rctest
Address COMMAND 'gzip >'quote(exitname) '-cd 'arg(1)
drop sss;options failat 9
return "GZip"
exttar:
rctest=3
if pathexists('gnutar') then txc='gnutar -p -x -f'
else if pathexists('tar') then txc='tar -a -x -f'
else do
txc='detar'
rctest=9
end
options failat rctest
Address command txc arg(1)
options failat 9
drop txc;return 'TAR'
extpak:
Address COMMAND arg(1)
return "PAK"
checklha:
call open(check,arg(1),r)
seek(check,2,B)
if readch(check,3)=="-lh" then do
close(check)
return 1
end
close(check)
return 0
lha_h_l:
call open(headercheck,(strip(arg(1),B,'"')),r)
seek(headercheck,20,B)
val=readch(headercheck,1)
close(headercheck)
return val
checkzip:
call open(check,arg(1),r)
if readch(check,2)=="PK" then do
close(check)
return 1
end
close(check)
return 0
checkarj:
call open(check,arg(1),r)
if readch(check,2)=="`ê" then do
close(check)
return 1
end
close(check)
return 0
checkrar:
call open(check,arg(1),r)
if readch(check,3)=="Rar" then do
close(check)
return 1
end
close(check)
return 0
checkshr:
return (checkxar(arg(1)) & (right(arg(1),(length(arg(1))-lastpos('.',arg(1))))='shr'))
checkxar:
call open(check,arg(1),r)
if readch(check,4)=="FORM" & right(readch(check,8),4)=="CDAF" then do
close(check)
return 1
end
close(check)
return 0
checktgz:
call open(check,arg(1),r)
if ((upper(right(arg(1),3))='TGZ' | upper(right(arg(1),6))='TAR.GZ') & readch(check,3)=='1f8b08'x) then do
close(check)
return 1
end
close(check)
return 0
checktar:
open(ch,arg(1),r)
call seek(ch,100) /* Moves up to the needed position*/
/* Nooow... let's try with lots of triple checks including datatype() calls....*/
select
when ~tlc(7) then signal notar
when ~tlc(7) then signal notar
when ~tlc(7) then signal notar
when ~tlc(30) then signal notar
otherwise close(ch);return 1
end
notar:
close(ch);return 0
tlc:
do arg(1)
ts=readch(ch,1)
if ~(ts==' ' | datatype(ts,N) ) then return 0
end
if readch(ch,1)=='0'x then return 1 /* The string is 0 terminated....*/
return 0
checkgzip:
call open(check,arg(1),r)
if readch(check,3)=='1f8b08'x then do
close(check)
return 1
end
close(check)
return 0
checkhpack:
call open(check,arg(1),r)
if readch(check,4)=="HPAK" then do
close(check)
return 1
end
close(check)
return 0
checkzoo:
call open(check,arg(1),r)
if readch(check,4)=="ZOO " then do
close(check)
return 1
end
close(check)
return 0
checkarc:
call open(check,arg(1),r)
if readch(check,2)=='1a08'x then do
close(check)
return 1
end
close(check)
return 0
checkpak:
call open(check,arg(1),r)
call seek(check,248)
if readch(check,11)=='dos.library' then do
close(check)
return 1
end
close(check)
return 0
Size: procedure
return word(statef(arg(1)),2)
fano:
do id=1 to omit.0
if length(omit.id)-length(compress(omit.id,'#?'))=0 then
if ~exists(omit.id) then iterate
address command 'delete >NIL:' quote(omit.id) 'FORCE'
end
do id=1 to add.0
if ~exists(add.id) then iterate
ADDRESS COMMAND 'Copy' add.id tempdir
end
return
initano:
if ~exists(anofile) then do
add.0=0
omit.0=0
return
end
open(in,anofile,r)
do until eof(in)
inline=readln(in)
if goodline(inline) then break
end
middle:
select
when inline=='ADD:' then call addano
when inline=='OMIT:' then call omitano
otherwise nop
end
if ~eof(in) then signal middle
if ~datatype(add.0,'N') then add.0=0
if ~datatype(omit.0,'N') then omit.0=0
return
addano:
count=0
do forever
inline=readln(in)
if (eof(in) | inline=='OMIT:') then do
add.0=count
return
end
if goodline(inline) then do
count=count+1;add.count=inline
end
end
return
omitano:
count=0
do forever
inline=readln(in)
if (eof(in) | inline=='ADD:') then do
omit.0=count
return
end
if goodline(inline) then do
count=count+1;omit.count=inline
end
end
return
goodline: procedure
if (left(arg(1),1)==';' | arg(1)=='') then return 0
return 1
failure:
signal off failure
if (RC=10 | RC=104 | RC=rctest) then do
Say bold"WARNING:"normal"Failed extracting "fullname" archive... skipping!"
midcleanup()
Writelog('Extraction error while unpacking' fullname 'archive... skipping!')
if sfm then exit(10)
else signal mainloop
end
else do
Say bold"WARNING:"normal"Problem encountered while creating new LZX archive (not enough memory ?)."
Say "Keeping original "fullname" archive."
call delete(dir||Newfile)
midcleanup()
Writelog('Could not create new LZX archive; keeping' fullname 'archive.')
if sfm then exit(10)
else signal mainloop
end
setuplib: procedure
parse arg library,v1,v2,v3
if(~show('l',library))then do
if(~addlib(library,v1,v2,v3))then do
say "Could not open" library"! Aborting..."
exit 10
end
end
return 1
writelog:
return WriteLN(log,date(e) time() arg(1))
initlog:
om='W'
if exists(logname) then om='A'
open(log,logname,om)
Writeln(log,cr)
WriteLog('Started 'verstring arg(1))
close(log)
open(log,logname,'A')
drop om;return
writelogoptions:
return Writelog('Options: Efficency' mode', BBSmode:' bbsmode)
pathexists: procedure
address command 'which >nil:' arg(1)
if rc=5 then return 0
return 1
whatis: procedure
return word(statef(arg(1)),1)
checklzx:
address command 'which >NIL: lzx'
if rc=5 then signal misslzx
lzxreg=exists('l:lzx.keyfile')
return
misslzx:
say "LZX is not in installed (or not in your search path)!"
exit(205)
mkdir: procedure
return makedir(arg(1))
quote: procedure
return '"'arg(1)'"'
halt:
break_c:
signal off break_c
signal off halt
signal off failure
Say "Yo, man! You pressed Control-c! Stopping execution...."
Writelog('User pressed Control-C, aborting....')
call midcleanup()
signal cleanup